/*
 *	Plurals
 *
 *	Author:	S.C.Merrall
 *
 *	File:	mp_foc.m
 *
 *	Contents:	mp_if
 *			mp_fi
 *			mp_elif
 *			mp_else
 *			mp_and
 *			mp_or
 *			mp_not
 *
 *	Description:	These functions give a method of manipulating the 
 *			active set. At this stage this can be easily made
 *			to affect the existing primitives since all
 *			primitives are accessed from the front end via
 *			the function main.
 *
 *	Change History:
 *
 *	Date   Name Comment
 *    -------- ---- -------
 *    16:05:91 SCM  Created
 *    23:06:91 SCM  Uses nil and not nil rather than a boolean integer
 *    23:06:91 SCM  Added the boolean operators as they work with same types
 *
 */

#include <mpl.h>
#include <stdio.h>

#include "constant.h"

#include "mp_object.h"
#include "mp_debug_off.h"
#include "mp_mem_mgmt.h"
#include "mp_gc.h"
#include "mp_type.h"

/*----------------------------------------------------------------------------*
 * Function   : and
 *
 * Parameters : MP_PluralHeap MPPH_arg1:	MasPar Plural heap handles
 *		MP_PluralHeap MPPH_arg2:	on the args and the results
 *		MP_PluralHeap MPPH_result:	heap space.
 *
 * Description: Preforms the and operation in a lisp sense, i.e. it merely 
 *		looks at the addresses, NIL corresponds to false and anything
 *		else is true. The contents don't need to be examined since
 *		nil has a unique address.
 *
 * Result     : int:	FAIL/SUCCESS
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

int and( MP_PluralHeap MPPH_arg1, MP_PluralHeap MPPH_arg2, 
	 MP_PluralHeap MPPH_result )

#else

int and( MPPH_arg1, MPPH_arg2, MPPH_result )

MP_PluralHeap MPPH_arg1;
MP_PluralHeap MPPH_arg2;
MP_PluralHeap MPPH_result;

#endif

{
  int result_status = SUCCESS;
DBG_CALL("and");
DBG_ARGS(DBG_PARG("MPPH_arg1","%x ",MPPH_arg1);DBG_PARG("\nMPPH_arg2","%x ",MPPH_arg2);DBG_PARG("\nMPPH_result","%x ",MPPH_result));

DEBUG(DBG_PARG("*MPPH_arg1","%d ",OA_offsets(MPPH_arg1)));
DEBUG(DBG_PARG("*MPPH_arg2","%d ",OA_offsets(MPPH_arg2)));


  if ((OA_offsets(MPPH_arg1) == NIL) || (OA_offsets(MPPH_arg2) == NIL)) {

    OA_offsets(MPPH_result) = NIL;
  }
  else {

    OA_offsets(MPPH_result) = NOT_NIL;
  }

DBG_EXIT(fprintf(dbg,"SUCCESS");DBG_PARG("*MPPHH_result","%d ",OA_offsets(MPPH_result)));
  return SUCCESS;
}

/*----------------------------------------------------------------------------*
 * Function   : or
 *
 * Parameters : MP_PluralHeap MPPH_arg1:	MasPar Plural heap handles
 *		MP_PluralHeap MPPH_arg2:	on the args and the results
 *		MP_PluralHeap MPPH_result:	heap space.
 *
 * Description: Preforms the or operation in a lisp sense, i.e. it merely 
 *		looks at the addresses, NIL corresponds to false and anything
 *		else is true. The contents don't need to be examined since
 *		nil has a unique address.
 *
 * Result     : int:	FAIL/SUCCESS
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

int or( MP_PluralHeap MPPH_arg1, MP_PluralHeap MPPH_arg2, 
	 MP_PluralHeap MPPH_result )

#else

int or( MPPH_arg1, MPPH_arg2, MPPH_result )

MP_PluralHeap MPPH_arg1;
MP_PluralHeap MPPH_arg2;
MP_PluralHeap MPPH_result;

#endif

{
  int result_status = SUCCESS;
DBG_CALL("or");
DBG_ARGS(DBG_PARG("MPPH_arg1","%x ",MPPH_arg1);DBG_PARG("\nMPPH_arg2","%x ",MPPH_arg2);DBG_PARG("\nMPPH_result","%x ",MPPH_result));

DEBUG(DBG_PARG("*MPPH_arg1","%d ",OA_offsets(MPPH_arg1)));
DEBUG(DBG_PARG("*MPPH_arg2","%d ",OA_offsets(MPPH_arg2)));

  OA_offsets(MPPH_result) = NIL;

  if (OA_offsets(MPPH_arg1) != NIL) OA_offsets(MPPH_result) = NOT_NIL;

  if (OA_offsets(MPPH_arg2) != NIL) OA_offsets(MPPH_result) = NOT_NIL;

DBG_EXIT(fprintf(dbg,"SUCCESS");DBG_PARG("*MPPHH_result","%d ",OA_offsets(MPPH_result)));
  return SUCCESS;
}

/*----------------------------------------------------------------------------*
 * Function   : not
 *
 * Parameters : MP_PluralHeap MPPH_arg1:	MasPar Plural heap handles
 *		MP_PluralHeap MPPH_result:	on heap space.
 *
 * Description: Preforms the not operation in a lisp sense, i.e. it merely 
 *		looks at the addresses, NIL corresponds to false and anything
 *		else is true. The contents don't need to be examined since
 *		nil has a unique address.
 *
 * Result     : int:	FAIL/SUCCESS
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

int not( MP_PluralHeap MPPH_arg1, MP_PluralHeap MPPH_result )

#else

int not( MPPH_arg1, MPPH_result )

MP_PluralHeap MPPH_arg1;
MP_PluralHeap MPPH_result;

#endif

{
  int result_status = SUCCESS;
DBG_CALL("or");
DBG_ARGS(fprintf(dbg,",MPPH_arg1=????,MPPH_arg3=????"));

  if (OA_offsets(MPPH_arg1) == NIL) OA_offsets(MPPH_result) = NOT_NIL;
  else OA_offsets(MPPH_result) = NIL;

DBG_EXIT(fprintf(dbg,"SUCCESS:");DBG_PARG("","%d ",OA_offsets(MPPH_result)));
  return SUCCESS;
}

/*----------------------------------------------------------------------------*
 * Function   : mp_if
 *
 * Parameters : MP_PluralHeap MPPH_boolean:	MasPar Plural Heap object, 
 *						handle on heap space of an 
 *						state.
 *		MP_PluralHeap MPPH_context:	Top of current oontext stack
 *
 * Description:    The new context is calculated by combining the given
 *		boolean with the one on the top of the context stack. This is
 *		then put on to the top of the context stack.
 *
 * Result     : int:	FAIL/MP_NONE_ACTIVE/MP_SOME_ACTIVE
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

int mp_if( MP_PluralHeap MPPH_boolean, MP_PluralHeap MPPH_context )

#else

int mp_if( MPPH_boolean, MPPH_context )

MP_PluralHeap MPPH_boolean;
MP_PluralHeap MPPH_context;

#endif

{
  int result;
  plural natural *plural old_context;
  plural natural *plural new_context;
DBG_CALL("mp_if");
DBG_ARGS(fprintf(dbg,"MPPH_boolean=%04x,MPPH_context=%04x",MPPH_boolean,MPPH_context));

DBG_ARGS(DBG_PARG("MPPH_boolean","%x ",MPPH_boolean);DBG_PARG("\nMPPH_context","%x ",MPPH_context));

  old_context = (plural natural *plural) OA_data(MPPH_context);

/*DEBUG(DBG_PARG("boolean","%d",OA_offsets(MPPH_boolean)));
DEBUG(DBG_PARG("car of stack","%d ",*old_context));
DEBUG(DBG_PARG("cdr of stack","%d ",*(old_context + 1))); 
*/

DEBUG(DBG_PARG("ps[2589]","%d ",plural_memory[2589]));	

  if (cons(MPPH_boolean, MPPH_context, MPPH_context) == FAIL) {

DBG_FAIL(fprintf(dbg,"FAIL: Unable to cons up context stack"));
    return FAIL;
  }

DEBUG(DBG_PARG("ps[2589]","%d ",plural_memory[2589]));	

  new_context = (plural natural *plural) OA_data(MPPH_context);
  *new_context = NIL;

  if (*old_context != NIL) {

    if (OA_offsets(MPPH_boolean) != NIL) *new_context = NOT_NIL;
  }

/*DEBUG(DBG_PARG("car of stack","%d ",*new_context));
DEBUG(DBG_PARG("cdr of stack","%d ",*(new_context + 1)));
*/
  if(globalor(*new_context != NIL) == 0) result = MP_NONE_ACTIVE;
  else result = MP_SOME_ACTIVE;

DBG_EXIT(fprintf(dbg,"%d",result));
  return result;
}


/*----------------------------------------------------------------------------*
 * Function   : mp_elif
 *
 * Parameters : MP_PluralHeap MPPH_stack:	Similarly for context stack
 *
 * Description: This operation is similar to fi, except it updates the 
 *		state of the previous context, the running context, which
 *		shows how many sites have yet to evaluate to true in a cond
 *		expression which behaves in a way similar to switch
 *
 * Result     : int:	FAIL/MP_NONE_ACTIVE/MP_SOME_ACTIVE
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

int mp_elif( MP_PluralHeap MPPH_stack )

#else

int mp_elif(  MPPH_stack )

MP_PluralHeap MPPH_stack;

#endif

{
  int result;
  plural natural *plural old_context;
  plural natural *plural running_context;
DBG_CALL("mp_elif");
DBG_ARGS(DBG_PARG("MPPH_stack","%04x ",MPPH_stack));

  old_context = (plural natural *plural) OA_data(MPPH_stack);
  cdr( MPPH_stack, MPPH_stack );
  running_context = (plural natural *plural) OA_data(MPPH_stack);

  if (*old_context == NOT_NIL) *running_context = NIL;

  if (globalor(*running_context != NIL) == 0) result = MP_SOME_ACTIVE;
  else result = MP_NONE_ACTIVE;

DBG_EXIT(fprintf(dbg,"%d",result));
  return result;
}


/*----------------------------------------------------------------------------*
 * Function   : mp_else
 *
 * Parameters : MPPH_context:	Context stack to be elsified 
 *
 * Description: Pops the current context off the stack nots it and 
 *		and ands that value with the top of the stack and pushses
 *		this value back on to the stack.
 *
 * Result     : int FAIL/SUCCESS
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

int mp_else( MP_PluralHeap MPPH_context )

#else

int mp_else( MPPH_context )

MP_PluralHeap MPPH_context;

#endif

{
  int result;
  plural natural tmp;
  MP_PluralHeap MPPH_tmp = &tmp;
  plural natural *plural old_context;
  plural natural *plural context;
DBG_CALL("mp_else");
DBG_ARGS(fprintf(dbg,"MPPH_context = ????"));

  if (cdr(MPPH_context, MPPH_tmp) == FAIL) {

DBG_FAIL(fprintf(dbg,"FAIL: cdr of context stack failed"));
    return FAIL;
  }

  old_context = (plural natural *plural) OA_data(MPPH_tmp);
  context = (plural natural *plural) OA_data(MPPH_context);

  if (*old_context != NIL) {

    if (*context == NIL) *context = NOT_NIL;
    else *context = NIL;
  }

  if (globalor(*context != NIL) == 0) result = MP_NONE_ACTIVE;
  else result = MP_SOME_ACTIVE;

DBG_EXIT(fprintf(dbg,"%d",result));
  return result;
}

/*----------------------------------------------------------------------------*
 * Function   : mp_fi
 *
 * Parameters : MP_PluralHeap MPPH_context:	Top of current context stack
 *
 * Description:    Descends the context stack a level. If it goes beyond the
 *		bottom of the stack this is an error.
 *
 * Result     : int:	SUCCESS/FAIL
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

int mp_fi( MP_PluralHeap MPPH_context )

#else

int mp_fi( MPPH_context )

MP_PluralHeap MPPH_context;

#endif

{
  
DBG_CALL("mp_fi");
DBG_ARGS(fprintf(dbg,"MPPH_context=%04x",MPPH_context));

  if (cdr(MPPH_context,MPPH_context) == FAIL) {

DBG_FAIL(fprintf(dbg,"FAIL: cdr of context stack failed"));
    return FAIL;
  }

DBG_EXIT(fprintf(dbg,"SUCCESS"));
  return SUCCESS;
}

/*----------------------------------------------------------------------------*
 * Function   : make_context_stack
 *
 * Parameters : MPPH_context_stack:	MasPar Plural Heap (object), handle
 *					on heap space of context stack
 *
 * Description:    Each plural has a context stack associated with it.
 *		Initially there was a global context stack however as 
 *		different plurals could be allocated on the same PEs
 *		they would interefere with each others context.
 *		
 * Result     : int:	FAIL/SUCCESS
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

int make_context_stack( MP_PluralHeap MPPH_context_stack )

#else


int make_context_stack( MPPH_context_stack )

MP_PluralHeap MPPH_context_stack;

#endif

{
  plural natural nil = (plural natural) NIL;
  MP_PluralHeap MPPH_nil = &nil;
  plural natural not_nil = (plural natural) NOT_NIL;
  MP_PluralHeap MPPH_not_nil = &not_nil;
DBG_CALL("make_context_stack");
DBG_ARGS(fprintf(dbg,"MPPH_context_stack = ????"));
  GC_Protect(nil);
  GC_Protect(not_nil);

  if (cons(MPPH_not_nil, MPPH_nil, MPPH_context_stack) == FAIL) {

DBG_FAIL(fprintf(dbg,"FAIL: Unable to create context stack"));
    return FAIL;
  }

  GC_UnProtect(2);
DBG_EXIT(fprintf(dbg,"SUCCESS"));
  return SUCCESS;
}
